/** This robot is responsible for both the initial board setup. */ def id = \t. t end def elif = \t. \then. \else. {if t then else} end def else = id end def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; def mod : int -> int -> int = \i.\m. i - m * (i / m) end def isEven = \n. mod n 2 == 0; end /** One-based index */ def getLetterEntityByIndex = \idx. let letter = toChar $ idx - 1 + charAt 0 "a" in letter ++ "-tile"; end; def getOrdinal : text -> cmd int = \item. count $ item ++ "-ordinal"; end; def getValueHere = maybeItem <- scan down; ordNum <- case maybeItem (\_. return 0) getOrdinal; end; /** Swaps the element at the current position with the element "x" cells away. Useful for an in-place sort. Precondition: Facing east. */ def swapRelative = \x. if (x > 0) { currentItem <- grab; stride x; otherItem <- grab; place currentItem; turn back; stride x; place otherItem; turn back; } {}; end; /** Fisher-Yates shuffle on a physical array Precondition: * Array is oriented horizontally * Robot is placed at the head (left end) of the array * Robot is facing right "n" is the size of the array. */ def shuffle = \n. \i. if (i < n - 1) { let randAmplitude = n - i in x <- random randAmplitude; swapRelative x; move; shuffle n $ i + 1; } {}; end; // Inner loop in inversion-counting algorithm def countInnerInversions = \n. \referenceVal. \j. if (j < n - 1) { move; valueHere <- getValueHere; let addend = if (referenceVal > valueHere) {1} {0} in recursiveSum <- countInnerInversions n referenceVal $ j + 1; let foo = recursiveSum in return $ addend + foo; } { return 0; }; end /** "n" represents array length. Runs in O(n^2) time. */ def countInversions = \n. \i. if (i < n - 1) { valueHere <- getValueHere; innerCount <- countInnerInversions n valueHere i; let innerCountFoo = innerCount in turn back; // Go backward one fewer space each time. stride $ n - i - 2; turn back; subarrayInversions <- countInversions n $ i + 1; let foo = subarrayInversions in return $ innerCountFoo + foo; } { return 0; }; end /** Left is a Boolean indicating whether the tile has been drilled. Right is a valid tile entity name. */ def scanValid : dir -> cmd (bool + text) = \d. maybeTileForward <- scan d; case maybeTileForward (\_. return $ inL false) (\x. if (x == "sliding-tile") { return $ inL true; } { y <- getOrdinal x; return $ if (y > 0) { inR x; } { inL false; }; }; ); end /** Precondition: The original item was a valid tile. Returns true if a drilling took place. Returns false if something unexpected happened and we should abort/reset. */ def actOnItemComparison = \maybeNewItem. \original. case maybeNewItem (\isSlidingTile. if isSlidingTile { create original; place original; move; grab; // Abort early from the recursion. return false; } { // The new tile is not a sliding tile. // We assume it's a blank tile and move there. // If it turns out not to be blank, that will // be addressed in the outer "observe" loop. move; return false; }; ) (\newItem. let isSame = newItem == original in // We expect the tile to be unchanged, if it is not a sliding tile. if isSame {} { say $ "Original was " ++ original ++ "; newItem was " ++ newItem; }; return isSame; ); end; def unwind = \keepChecking. \maybeItem. if keepChecking { turn right; // For now, we assume that there exist no "drilled" tiles // at the "wind-up"; the drilling shall always happen while // we are waiting at the peak of the recursion stack. maybeItem2 <- scanValid forward; keepGoing <- case maybeItem ( \isSlidingTile. if isSlidingTile { // Our assumption was invalid; we don't have a // valid reference tile to compared the drilled tile to. say "Unexpected drilling; no reference tile."; return false; } { return true; } ) (actOnItemComparison maybeItem2); return keepGoing; } { return false; }; end; /** If there is an odd number of inversions, simply swap the first two tiles to obtain the correct parity. */ def fixInversions = \arrayLoc. \arrayLength. teleport self arrayLoc; inversionCount <- countInversions arrayLength 0; if (isEven inversionCount) {} { teleport self arrayLoc; swapRelative 1; }; end; def layOrderedTiles = \n. if (n > 0) { let tileName = getLetterEntityByIndex n in create tileName; place tileName; move; layOrderedTiles $ n - 1; } {}; end; def prepareArray = \arrayLoc. \boardWidth. \boardHeight. turn east; teleport self arrayLoc; layOrderedTiles $ (boardWidth * boardHeight) - 1; teleport self arrayLoc; let cellCount = boardWidth * boardHeight in let arrayLength = cellCount - 1 in shuffle arrayLength 0; fixInversions arrayLoc arrayLength; end; def relocateEnt = \from. \to. teleport self from; emptyHere <- isempty; if emptyHere {} { e <- grab; teleport self to; place e; }; end; def placeSingleRow = \sourceRow. \boardWidth. \rowIndex. \colIndex. if (colIndex >= 0) { relocateEnt (rowIndex*boardWidth + colIndex, sourceRow) (colIndex, -rowIndex); placeSingleRow sourceRow boardWidth rowIndex $ colIndex - 1; } {}; end; def placeRandomizedPuzzle = \arrayLoc. \boardWidth. \rowIndex. if (rowIndex >= 0) { placeSingleRow (snd arrayLoc) boardWidth rowIndex $ boardWidth - 1; placeRandomizedPuzzle arrayLoc boardWidth $ rowIndex - 1; } {}; end; def drawBorderLine = \boardSideLength. let b = "border" in doN (boardSideLength + 1) $ ( create b; place b; move; ); turn right; end; def createBorder = \boardWidth. \boardHeight. teleport self (-1, 1); turn east; doN 2 ( drawBorderLine boardWidth; drawBorderLine boardHeight; ); end; def setupGame = \boardWidth. \boardHeight. createBorder boardWidth boardHeight; let arrayLoc = (0, -6) in prepareArray arrayLoc boardWidth boardHeight; placeRandomizedPuzzle arrayLoc boardWidth $ boardHeight - 1; teleport self (6, -6); // Sentinel to indicate we are ready to start checking goal condition create "flower"; // Sentinel that the maintainer can start checking create "flower"; r <- robotnamed "maintainer"; give r "flower"; end; def go = \boardWidth. \boardHeight. instant $ setupGame boardWidth boardHeight; end; go 3 3;